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“BASSMAT_IDN IS-SER-19 :41 YAX/VMS Macro v04-00 Pece 1 
ete a-$Ep=19be 10:59:18 POASRTE RETGAMMATGON.maR1 2% ct) 
1 -TITLE BASSMAT_IDN 
§ . IDENT /1-012/~ ; File: BASMATIDN.MAR Edit: MDL1012 
5 ¢ PITITITITITITITIIITI ITI TIT I TI TTITi TTT iiiiiiiiiiiiiiiiiiiiiiiiiiiii iii iii 
3% 7 
§ ;* ttl bg iF: 1978, 1980, 1982, 1984 BY * 
3* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. . 
4 : :* ALL RIGH S RESERVED. - 
000 1 ie THIS SOFTWARE is FURNISHED UNDER A LICENSE AND MAY BE USED AND gt * 
00 11 ;* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH biCeee AND WITH THE ® 
O80 \§ 3* INCLUSION OF THE ABOVE ceria HT NOTICE. THIS SOFTWARE OR ANY OTHER *# 
0 15 ;* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
000 14 ;* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
38 12 is TRANSFERRED. * 
Py - 
00 i$ 3* THE gta IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE a 
00 1% 3;* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
44 } ‘* CORPORATION. : 
0090 1 e DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
000 § 3* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 
8 
+45 5 Peeeeeeeeeeereedeneeeneneenaneeeeeeeteeeeeeeeeeeeeereneeeeneeeereneeereres 
0000 3 
88 
9000 3 * FACILITY: BASIC code support 
9000 1 : ABSTRACT: 
0000 j : This module initializes a matrix to have zeros everywhere except 
464 : 3 ones on the diagonal. 
0000 6 : ENVIRONMENT: User Mode, AST Reentrant 
000038: 
9000 33 : AUTHOR: R. WiLL, CREATION DATE: 29-May-79 
9000 41 i MODIFIED BY: 
0000 rk : 1-001 - Original 
sit 44 ; 1-002 - Reference bounds as signed, not unsigned. RW 77-Jun-79 
00 45 ; 1-003 - Add support for byte, g and h floating. PLL 17-Sep-81 
000 $6 3; 1-004 = More modifications for new data types. Put 24-Sep-81 
000 47; 1-383 - Changed shared external references to G* RNH 25-Sep-81 
00 $8 3; 1-006 - Substitute a macro for the calls the array store 
00 49 ; routines. This should speed things up. PLL 6-Nov-81 
00 0 ; 1-007 = STORE macro must handle g & h floor ing, PLL 12-Nov-81 
4 1; 1-008 - PLL SbeJan ar prttae expression in the STORE macro. 
00 : : 1-009 - Changed ae STORE to handle arrays of descriptors. 
00 4; Also gested ¢ check in geint ing se ode to handle arrays of 
00 S$; descriptor LEB 28-JUN-1 
0 § : 1-819 - Fixed bug n STORE macro. LEB 4-JUL-19 
00 ; 1-011 = Change own storage to stack storage. (2 *5-yut-1982 
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“012 - use G* for ALL externals. 
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BASSMAT_IDN 15-SEP-1984 23:43:41 VAX/VMS Macro v04-00 Pa 
Sir DECLARATIONS g-SEp- 198 13:3 718 (BASRTL.SRCJBASMATION.MAR; 1 a 3) 
| 
6 6) ~SBTTL DECLARATIONS 
| 84 ; INCLUDE FILES: 
64 ; 
65 
06 SOSCDEF 
6 SSF DEF 
3 
4 oy ¢ EXTERNAL DECLARATIONS: 
44 8 -DSABL GBL ; Prevent undeclared 
0 7 3; symbols from being 
0000 74 3; automatically p'g al. 
000 75 -EXTRN BASSK_ARGDONMAT ; signalled if al blocks 
000 7 3 not present in array desc 
000 7 eEXTRN BASSK_DATTYPERR : signalled if dtype of arra 
000 7 3; isn't word long float double 
000 7 -EXTRN BASSK_MATDIMERR 3; array wasn't 2 dimensional 
000 0 -EXTRN BASS$STO_FA_B_R ; array element store for byte 
000 1 -EXTRN BASSSTO_FA_W_R ; array element store for word 
000 ¢ -EXTRN BASSSTO_FA_L_R ; array element store for long 
0000 8 -EXTRN BASSSTO_FA_F_R ; array element store - float 
0000 84 eEXTRN He toh ee a ; array element store - double 
0000 $2 -EXTRN BASSSTO_FA_G_R ; array element store - gfloat 
0000 6 TRN BASS$STO_FA_H_R8 ; array element store - hfloat 
0000 87 EXTRN BASSS$STOP ; signal fatal errors 
0000 88 EXTRN BASSSSCALE_R1 i; get the scale for double 
0000 89 EXTRN BASSSTORE_BFA ; Store value in array 
0000 90 
0000 91 ; 
8000 38 3; MACROS: 
000 92 3 
0000 94 
0000 93 é SBASSMAT_IDN see below, defines entire identity init algorithm 
0000 96 ; STORE store an element into an array 
0000 97 
B88 98 ; 
000 99 ; EQUATED SYMBOLS: 
944 100 ; 
000 101 
00000000 0000 198 lLower_bnd2 = 0 ; stack offset for temp 
00000004 0000 10 lower_bndi = 4 3: stack offset for temp 
sth 4 44 104 upper_bndl = ’ 3 stack offset for temp 
000000C 0 105 value_desc = 12 ; output descriptor 
0000000C 0000 106 str_len = 12 ; length field within desc 
0000000E 0000 107 dtype = 14 ; data type field in desc 
O000000F 0000 108 class = 15 :; class field within desc 
898 0010 4 109 pointer = 16 
0000014 0 110 ata = 20 ; data 
0000024 00 111 one _cvt = 36 ; stack offset,converted one 
000001¢ 000 118 dsc$l_l1_2 = 28 : desc offset if 2 sub 
0000020 00 11 dsc$l_ul_2 = 32 : desc offset if 2 sub 
0000024 . 114 sc$l_l2_2 = 36 ; desc offset if 2 sub 
0000028 p 0 116 dsc$l_ue_2 = 40 ; desc offset if 2 sub 
117 ; 
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Br$Eb=1984 10:29:18 Loasnre. SAC IGASHATSON.MAR: 1 
8 3 OWN STORAGE: 
? 
é PSECT DECLARATIONS: 
4 -PSECT _BASSCODE PIC, USR, CON, REL LCL, SHR, 
2 EXE, RD, NOWRT. LONG 


Page 


4 
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| BASSMAT_IDN 15-SEP-1984 23:43:41 VAX/VMS Macro v04-00 Pa 
kets BASSMAT_IDN = Initialize a matrix to i g-SEp- 1986 93:5 :18 (CBASRTL.SRCJBASMATION.MAR; 1 = 3) 
| -SBTTL BASSMAT_IDN = Initialize a matrix to identity matrix 
| FUNCTIONAL DESCRIPTION: 
This routine initializes the input matrix to the identity matrix 
by setting all diagonal elements to 1 and all the remaining elements 
to zero. The algorithm is the same for all the supported 
BASIC data types. In order to keep the code for the data types 
the same and to simplify the reading, the code has been done as 
a macro, which all the data types use varying only the letters 
. W, L, F, 0, G, H) in converting the ones and zeros, in passing the const 
and calling the array store routines. 
CALLING SEQUENCE: 
CALL BASMAT_ION (matrix.wx.da) 
INPUT PARAMETERS: 
NONE 
IMPLICIT INPUTS: 
Scaling from the callers frame (for the double precision one) 
OUTPUT PARAMETERS: 
matrix = 4 
IMPLICIT OUTPUTS: 
NONE 


FUNCTION VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 
This routine will call the BASIC array store routines and so may 


cause any of their errors to be signalied. It may also signal any 
of the errors Listed in the externals section. 
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ASSMAT_IDN “SEP=1984 24 AX/VMS Macro v04-00 Page 
; 12 BASSMAT_IDN = Initialize a matrix to i yee st} 8; $3; 18 EBASRIL. SRCIJBASMATIDN.MAR; 1 . (2) 
175 ;¢ 
178 3; This macro is a pybetitute . alls to the ere store 
0 177 ; routines. It will call t routines onl the array is a 
178 3; virtual array. lOthervise.. ie on itl lt calculate the linear index into 
0 179 ; oy a hhy | via the INDEX instruction. (Note that BASIC gy et must 
4 180 ; be able to hondle FORTRAN arrays, so the code must check for arra 
0 181 ; stored by column.) The INDEX metructions should provide a significant 
00 1 ¢ 3; performance improvement over calling a routine for each elemen 
44 : ; ; the array. 
33 188 «MACRO STORE array_dtype,?L1,7L2,27L3,7L4,7L5,?2L6, 27L7,7L8, 2L9,7L10, 7L12,7L 
00 1 IF IDN ‘array_dtype', H array is hfloat 
0000 188 CMPB dsc$b_dt pe (Rat, hasc$k dtype dec ; descriptor? 
0000 189 BNEQ LI 4 —! 
0000 190 MOVL 4(R4), RO :; fetch addr of descriptor 
0000 191 MOVB p set 1 “dtype(RO), dtype(sp) ; load in data typ 
0000 136 Ove dsc$b_class(RO), class(sp) 3; load in class Reld 
0000 «(+19 MOVAQ data(SP), pointer (SP) ; load in pointer field 
0000 194 CMPB peor # ; check # of dimensions 
0000 195 BNEQ 1 3; branch if 2 dimensions 
0000 196 PUSHL 3; value of Ist index 
0000 197 PUSHL ; addr of array desc 
0000 §=6198 PUSHAL He desc+8(SP) 3; addr of value desc 
0000 199 CALLS #3,G*BASSSTORE BFA 
0000 00 BRwW 
0000 01 L12: PUSHL t? ; value of 2nd index 
0000 8 PUSHL R5 3 value of Ist index 
0000 0 PUSHL R4 3; addr of array desc 
0000 04 PUSHAL value _desc+12(SP) ; addr of value desc 
0000 05 CALLS #4,G*BASS$STORE_BFA 
0000 206 BRW 
0000 207 L10: CMPB dsc$b_class(R4), Mdsc$k_class_bfa ; virtual array? 
0000 $05 BNEQ 3; no 
0000 09 JSB G*BASSSTO_FA ies dtype’_R&8 ; yes, call store routine 
0000 i? BRwW L9 : done 
0000 17 L1: BBS #5, 10(R4 : br if stored row-wise 
9009 ei2 INDEX R5, dsc$l_ at Users), dsc$t_ul corel ‘Sgt m2(R4), #0, R7 
0000 14 MOVZ2WL dsc$w_length(R4) neh, Length for INDEX 
0000 215 INDEX R6, dsc$l_L2 RAD Sascsl _u2 -2nhy, R7 
0000 16 (J + * m2)) * Length 
0000 17 ADDL dsc$a_ aQ(R4), R7 ; F Soanete addr of element 
ti \8 an orve dtype' RO, (R7) : store element from RO 
49 $9 L2: INDEX R6, dsc$l_l2_2(R4), dsc$l_u2 at vat mi(R4), #0, R7 
0000 32 MOVZ2WL dsc$w_length(R4) aL Length for INDEX 
0000 INDEX R5, dSc$L_L1 RAD Sasc$t _ul 2inky, 
0000 4 Pars ese ee m1)? * Length 
4 5 ADDL dsc$a_ a0(R4), R7 3 a. addr of element 
000 § Woy ervey. dtype' RO, (R7) 3; store element from RO 
0 IF IDN array_dtype', G array is gfloat 
e $ CHB dsc$b seni Wasc$k dtype_dsc ; descriptor? 
000 1 MOVL 4(R2), R 3; fetch addr of descriptor 
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BASSMAT_IDN 15*SEP=1984 23:43:41 VAX/VMS Macro v04-00 Page 7 
we tts BASSMAT_IDN = Initialize a matrix to i ra ioet} 7 18:38:48 EBASRIL. SRC IGASMATION.MAR: 1 . (4) 
6° ¢ MOVB dsc$b ~dtype (RO). dtype(SP) 3; load in data type 
MOVB dsc$b_ class(RO), class(SP) ; load in class field 
8 4 MOVAQ data(SP), pointer (SP) ; load in pointer field 
0 5 CMPB d g$b. diner Roy # 3 check # of dimensions 
00 $ BNEQ 3; branch if 2 dimensions 
000 PUSHL R 3; value of Ist index 
000 8 PUSHL R 3; addr of array desc 
000 PUSHAL value _desc+8(SP) 3; addr of value desc 
000 rk CALLS »G*BASSSTORE BFA 
000 4 BRw {3” 
000 g L22 PUSHL R4 : value of 2nd index 
44 4 PUSHL : : value of ist index 
0 44 PUSHL 3: addr of array desc 
0000 45 PUSHAL ~ Fae desc+12(SP) 3; addr of value desc 
464 ‘3 gauls “3° G*BASS$STORE BFA 
9444 rf L20: we 4 c$b_class(R2), #dsc$k_class -bfa ; virtual array? 
3 no 
0000 50 JSB G*BASSSTO. FA_‘array_dtype'_R8 =; yes, call store routine 
0000 51 BRW L9 3 gen =P 
0000 26 L3 BBS #5, 10(R2) ° f stored row-wise 
9000 $33 INDEX R3, dscSl_ ut +3R2), dsc$l_ul cath ascsi _m2(R2), #0, RS 
0000 55 MOVZWL Soctu _length(R2) car) length for INDEX 
0000 36 INDEX , dsc$l_l2_ joey oo _u2_ 20R8); R5 
0000 5 (J + # M2)) * Length 
0000 58 ADOL dsc$a ~20(R2), ; S Seeoutt addr of element 
+464 $25 fica dtype' at (R5) 3; store element from RO 
44 $61 L4: INDEX R4, dsc$l_l2_2(R2), dsc$l_u2 er dsc$l mi(R2), #0, RS5 
0000 $8 MOVZWL dsc$w_length(R2 a a Length for INDEX 
0000 264 INDEX R3, dsc$l_L1 Hitt, SascSt _ul _2(R3), R5 
0000 65 ; (+s # M1)? ® Length 
0000 266 ADDL dsc$a ~20(R2), 5 ad addr of element 
44 eh es ¢ Macchia dtype' oa’ (R5) 3; store element from RO 
0000 269 IF IDN arra dt ype D array is double 
0000 70 CMPB des, sven dsc$k_dtype_dse 3; descriptor? 
0000 71 BNEQ L30 
0000 i; MOVL 4(R2), 3: fetch addr of _fescriptor 
0000 7 MOVB dsc$b * Pesta. dtype(SP) : load in data type 
0000 74 vB dsc$b-class(RO), class(SP) : load in clase ield 
B08 75 MOVAQ data(SP), pointer (SP) ; load in pointer field 
00 6 CMPB dsc$b_dimct(R2), #1 3; check # of dimensions 
4 7 BNEQ L353 : branch if 2 dimensions 
000 78 PUSHL 83 3; value of Ist index 
4 79 PUSHL ; addr of array desc 
000 80 PUSHAL we desc+8(SP) : addr of value desc 
9464 + cate #3,G°BASSSTORE BFA 
$00 58 L32: PUSHL t? 3; value of 2nd index 
000 4 PUSHL R353 ; value of Ist index 
4 5 PUSHL R2 : addr of array desc 
8 § PUSHAL value _desc+12( 7 ; addr of value desc 
0 CALLS #4,G*BASSSTORE_BFA 
00 8 BRw L9° 
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0090 8 L30: cnet dsc$b_class(R2), #dsc$k_class_bfa ; virtual array? 
i no 
0 91 JSB G“*BASSSTO_FA_‘array_dtype’_R8 ; call store routine 
4 35 BRW L9 3 done 
00 93 L5 BBS He 10(R2), L6 : br if stored col-wise 
309 3 INDEX R3, dsc$l_(1_2(R2), dsc$l_ut_2(R2) , dsc$l_m2(R2), #0, RS 
00 96 MOVZWL dsc$w_length(R2), R6 * Longword Length for INDEX 
000 597 INDEX Rae dEcSl ote. 2CRS). dsc$l_u2_2(RD), RO RS, Roe 
000 98 3 (J + (1 ® M2)) © Length 
000 99 ADDL dsc$a_a0(R2), RS ; compute addr of element 
44 89 ey ere dtype' RO, (R5) : eters element from RO 
: done 
44 8 L6: INDEX R4, dsc$l_l2_2(R2), dsc$l_u2_2(R2), dsc$l_mi (Re), #0, RS 
0000 04 MOVZWL dscS$w_length(R2), R6 > Longword Length for INDEX 
0000 305 INDEX R3, dec$t 711. 20R3), dsc$l_ul_2(R2), Re, RS, RS” 
0000 06 : (1 + (J ® M1)) © Length 
0000 07 ADDL dsc$a_a0(R2), R5 ; compute addr of element 
0000 08 MOV‘ array_dtype’ RO, (R5) 3; store element from RO 
0000 09 LFF 3; array type other than double 
0000 10 CMPB dsc$b_dtype(R1), #dsc$k_dtype_dsc ; descriptor? 
0000 11 BNEQ 40 
0000 \ MOVL 4(R1), RO : fetch addr of descriptor 
0000 1 MOVB dsc$b_dtype(RO), dtype(SP) ; load in data type 
0000 14 MOVB dsc$b_class(RO), class(SP) ; load in class field 
0000 315 MOVAQ data(SP), pointer (SP) ; load in pointer field 
0000 $18 CMPB dsc$b_dimct(R1), #1 : check # of dimensions 
0000 17 BNEQ L42 : branch if 2 dimensions 
0000 318 PUSHL R2 ; value of Ist index 
0000 19 PUSHL R11 3; addr of array desc 
0000 $59 PUSHAL value _desc+8(SP) ; addr of value desc 
0000 21 ALL #3,G*°BASSSTORE_BFA 
0000 $§ BRW L9 
0000 23 142: PUSHL R3 ; value of 2nd index 
0000 24 PUSHL R2 3; value of Ist index 
0000 25 PUSHL Ril 3; addr of array desc 
0000 $$ PUSHAL value_desc+12(SP) :; addr of value desc 
9000 ; CALLS #4 ,G*BASSSTORE_BFA 
0000 9 140: CMPB dsc$b_class(R1), Mdsc$k_class_bfa ;virtual array? 
0000 0 BNEQ 3 no 
0000 1 JSB G*BASSSTO_FA_‘array_dtype’_R8& =; call store routine 
44 § BRW L9 3 done 
L7: BBS #5, 10(R1), L8 ; br if stored col-wise 
9000 4 INDEX R2, dsc$l_(1_2(R1), dsc$l_ut_2cRt) dsc$l_m2(R1), #0, R4 
000 § MOVZWL ggchu_lengen (al R5 : Longuord Length for INDEX 
909 INDEX R3, dSc$l_l2_2(R1), dsc$t_u2_2(R1), R5, R4, R4 
8 : (2 4°CL & M2)) © Length 
4 9 ADDL dsc$a_a0(R1), R4 3 compute addr of element 
0 40 MOV‘ array dtype' RO, (R4) 3 store element from RO 
0000 41 RW ; done 
00 4g L8: INDEX R3, dsc$l_l2_2(R1), dsc$l_u2_2(R}), dsc$l_m1(R1), #0, R4 
09 44 MOVZWL dgcSu_lengen (a)? RS : Longuorg Length for INDEX 
45 INDEX R2, dSc$L_L1_2(R1), dsc$l_u1_2(R1), R5, R4, R4 
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- Initialize a matrix to i 
4 
23 ADDL * 
48 MOV‘ array_dtype' 
49 -ENDC 
50 ~ENDC 
51 -ENDC 
26 L9 
5 -ENDM 
54 


15-SEP=1 
6-SEP=1 


dsc$a_a0(R1), R4 


38 


4 
4 


10: 


RO, (R4) 


4 
2 


3; 


4 
1 


st 
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3 (1 + (J * M1)) © Length 
3 compute addr of element 
3 store element from RO 
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MACRO SBASSMAT_ION dtype : identity init algorithm 


+ edly USAGE 
pons ed by +s routines 


per bound for 2nd supece tpt 


| R10 pointer to ey Garr tor 
R11 current value of 2nd subscript 
0 
0 3¢ 
Be ; Set up Limits for looping through all elements 
00 : 
00 Pia #i, -(SP) ; make constant same data type 
0 i aS array, save on stack 
00 IF dtypes a? ; array is double 
00 MOVL SAVE_FP(FP), RO 3; pass FP to get ogete 
00 JSB stb save ECE R1 i; get scale in ROG R 
44 ; call a BLISS ~& Ki because 
000 ; the frame offsets are only 
4443 3; defined for BLISS 
000 MULD2 RO, (SP) 3; scale 
0000 -ENDC 
44 
000 CLROQ -(SP) ; alloc data 
0000 CLRQ -(SP) ; may be hfloat 
44 CLRQ -(SP) ; alloc value_desc 
0000 85 1$: CMPB DSCSB_DIMCT(R10), #2 3 geteraine ©, # of subscripts 
0000 36 BEQLU INIT_TWO_SUBS'dtype' $ ae, io init 
BO08 8 BRW ERR_MATDIMERR 3 not 2 subs, error 
Boe 88 
000 89 ;+ 
0000 90 : There are 2 subscripts. Put the up oper bound for both subscripts on the 
0000 91 : stack and make sure that the lower bound for both pubscr iets will start 
4448 8 3 at 1 (do not alter row or col 0 or any negative subscript 
0000 94 
B88 95 INIT_TWO_SUBS'dtype': 
000 36 PUSHL dsc $l ul (R10) 3 1st upper bound 
0000 9 PUSHL dsc$l_11_2(R10) ; Ist lower bound 
0000 98 BGTR 1$ 3; not row 0 or neg, do cols 
44 99 MOVL #1, (SP) 3 start with row 
400 1$ MOVL Gsc$t ugg (R10). R9 : znd upper bound 
000 $3 PUSHL dsc$l_l2_2(R10) ; end lower bound 
one 4 ; BGTR LOOP_2ND-SUB'dtype’ z not col 0 or neg, go loop 
00 40 MOVL #i, TSP) : start with col 
B33 
00 $26 3 | , op through all the revs. Row and column upper and lower bounds have been 
00 407 ; tialized on the stack 
3 408 A, 
: 409 
0 410 LOOP_1ST SUB" dtype" 
4h 3 AOVL ower_bnd2(SP), R11 ; R11 has 2nd lower bound 


( 
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:* 


LOOP_2ND_SUB’dtype’: 
BEQL 

CLR'dty 

BRB 

MOV dtype’ 


—s 
wn 
oe 


: others take 1 word. 


BPH BANNAN ONUNNPONONONENNN 2 Oe 


FWN SO ODNAUN EWN" OOONANE WN OOWONOAUE Ww 


;_bound is initialized in R11. 
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P1984 0:38: 8 UBASRTL. SA SRC JBASMATIDN.MAR; 1 


CMPL att. Lower _bnd1 (SP) 


one_cvt(SP), RO 


R3 


See if it was the 


upper _bnd1 (SP) 


2s: IF ION 
MOVL R10, R4 
MOVL lLower_bnd1(SP), 
MOVL Ri1, R6 
LFF 
IF IDN 
MOVL R10, R2 
MOVL lower_bnd1(SP), 
MOVL R11, R4 
LFF 
IF IDN 
MOVL R10, R2 
MOVL lLower_bnd1(SP), 
MOVL R11, R4 
445 ~IFF 
44 
44 MOVL e a 
448 MOVL lower apheot R2 
449 MOVL 1, R 
450 ~ENDC 
451 eENDC 
$26 -ENDC 
ns dart 
ype 
455 INCL 
$2$ CMPL R11, R9 
45 BGT 
$28 BRwW LOOP_2ND_SUB'dtype’ 
460 ;+ 
461 : Have completed entire row. 
$66 i : continue with next row. 
463 ;:- 
464 
465 3%: INCL Lower_bnd1 (SP) 
208 CMPL Lower_bnd1(SP), 
46 BGTR $ 
re BRwW LOOP_1ST_SUB'dtype’ 


; Loop through all the elements (columns) of the current row. Column lower 
Column upper bound is on the stack. 


see if dis egeges element 
yes, go pu 
no, a. to be stored 
cont 
put gcated 1 into RO 

R1 for double 


3° 
: When passed by value, H takes 4 words, G and D take 2 words, and all 


; is datatype hfloat 

; pointer to array desc 
; current cow 

; current column 


; datatype gfloat 

; pointer to array desc 
; current row 

; current column 


; datatype doubie 

; pointer to array desc 
; current row 

; current column 


; none of the above 

; pointer to array desc 

; current row 

; current column 

; code now same for ail types 
; store in array 

; get next column 

; see if last column done 


; no, continue inner loop 


last row. If not, 


t next row 


; 36 if last row done 
3 no, continue outer loop 


Panes SMAT_ION 


a ah 


15-SEP=1 


BASSMAT_IDN = Initialize a matrix to i 6-SEP-1 


—_— ——_—  - — + Ce e O 


be 10:25:18 


AX/VMS Macro v04-00 
BASRTL.SRCIJBASMAT IDN.MAR: 1 


: yes, finished 


Page 


1 
( 


3) 


, , 
E 12 
| BASSMAT_IDN = “$ P=1984 :4 AX/VMS Macro V04-00 Pa 13 
bear BASSMAT_IDN = Initialize a matrix to i SEP-1984 5; $3: 13 YBASRTL. SREIBASMATION. MAR; 1 - (6) 
| GFFC $23 sENTRY BASSMAT_ION, “M<R2,R3,R4,R5,R6,R7,RB,RI,R10,R11,1V> 
475 :¢ 
$78 ; Put routine arguments into registers for ease of u 
arp i= ; If block 2 of array descriptor (multipliers) is not “present then error. 
479° 
SA O4A dO 480 MOVL matrix 2 erre descr in R10 
| 3 OA AA OF «G1 (0006 48 BBC’ OSCEY FL BOUNDS, DSCSB LAFLAGS(RIOD, vERR A GDONMA 
4 ¢ ; exi t if block 3" not 
00B 4 3 sresent in descriptor 
3 484 
0B 485 ;+ 
sie 2 § ; Algorithm now differs according to data types 
008 488 
58 DO 0008 489 MOV R10, R8 ave ec OFYPe pointer 
05 06 02 A8  8F 00 490 4$ CASEB osc$B DTYPE(R8), #DSCSK_DTYPE_B, "#<DSCSK YPE_D = DSCSK_DTYPE_B> 
Fe 9 491 1$: «WORD BYTE-T$ 3 code for byté dtype 
146" 001 49 «WORD WORD-1$ 3; code for word dtype 
0238° oat 49 -WOR LONG-1$ 3; code for long dtype 
Oggn. 019 494 «WORD ERR_DATTYPERR-1$ 3; quad not supported 
0330° 00168 495 .WOR FLOAT=1 ; code for float dtype 
0425" 001D 496 «WORD DOUBLE-1$ ; code for double dtype 
OO1F 497 
OO1F 498 ;+ 
OO1F 499 ; G and H floating fall outside the range of the CASEB. 
ool Son 
1B 4O2A 91 OO1F 206 CMPB DSCSB_DTYPE(R8), #DSCSK_DTYPE_G 
0 12 bose 20 BNEQ 
0512 31 + 3 ene BRW GFLOAT ; code for gfloat dtype 
10 «(02 08 «(91 0038 306 2$: CMPB = DSC$B_DTYPE(R8), #DSCSK_DTYPE_H 
0 12 002C 50 BNEQ 
060 31 kt 208 BRW HFLOAT 3; code for hfloat dtype 
18 0208 91 0031 510 38: CMPB s«éSC$B DTYPE(RB), #DSC$K_DTYPE_DSC 
06 is 0035 a3 BNEQ ERR_DATT 
58 O04 AB OD oR \¢ MOVL ECRB), z= ; RB <-- addr of descriptor 
D1 11 Bae 312 BRB 4$ ; CASE again for dtype in desc 
03D 515 ERR_DATTYPERR: 
00000000°8F DD oR 1g PUSHL gpasen DATTYPERR :; Signal error, unsupported 
00000000'GF 01 FB See 4 CALLS G*BAS$SSTOP 3 dtype in array desc 
04A 519 ERR_ARGDONMAT: 
00000000'8F DD 004A 0 PUSHL SOASSE ARGDONMAT : signal er 
00000000'GF 01 FB B20 1 CALLS . G*BAS$$STOP : block 2 or *'s absent 
057 : ERR_MATDIMERR: . 
00000000°8F DD 0057 4 PUSHL SOASSE MATDIMERR : signal error not 2 for dimct 
00000000'GF 01 FB BR 20 2 CALLS #1, G*BASS$STOP 


: 
| 
| 
| 
| 
| 
| 


—___—_——_ 
F 12 
BASSMAT_IDN 15-SEP-1984 $3: 2:43:41 VAX/VMS Macro v04-00 Page 14 
1-012 BASSMAT_IDN = Initialize a matrix to i 6=SEP-19 0:29:18 (CBASRTL.SRCJBASMATIDN.MAR; 1 (6) 
; expand to byte operations 


0064 528 BYTE:  SBASSMAT_IDN B 


—K$ $+} 


Beet T=1ON BASSMAT_IDN 


0159 


Fo 
= Initialize a matrix to i 


530 WORD:  $BASSMAT_IDN w 


p-1 
P= 


Be 10:2 


yeriyes Macro v04-00 
YBASRIL. SREIGASMATIDN. MAR; 1 


; expand to word operations 


waren 


H 12 


BASSMAT_IDN = Initialize a matrix to i e-sePalobe 10:59;18 POASKTE. SAE SBAMMATS ON. MAR; 1 


024E 


532 LONG: 


SBASSMAT_IDN L 


: expand to long operations 


roe, 


i 


stg io 


BASSMAT_IDN 
0343 


I 12 
- Initialize a matrix to i 
534 FLOAT: SBASSMAT_ION F 


15-SEP-19 


6-SEP=19 


) 
4 


fo:35:18 


AX/VMS Macro V04-00 
BASRTL.SRCJBASMATIDN.MAR; 1 


3 expand to float operations 


Page 


17 
(6) 


SOU  -' _ ——- -> OO’? ————————nwn ———————— 


J 12 
15-SEP-19 :41 VAX/VMS Macro v06-00 Page 18 
BASSMAT_ION = Initialize © matrix to 1 SasePoioee WOidec1e LOAaN Te cae sbatearoow.mans1 ome 18 


0438 536 DOUBLE: SBASSMAT_IDN D 3 expand to double operations 


BARSBAT 10m ) 


15-SEP-1984 23: 1 VAX/VMS Macro v04-00 Pp 
BASSMAT_IDN = Initialize a matrix to i 6=SEP-1984 10:29:18 (CBASRTL.SRCJBASMATIDN. MAR; 1 


053A 538 GFLOAT: SBASSMAT_IDN G 3 expand to gfloat operations 


L 12 ssp 


BASSMAT_IDN = Initialize a matrix toi 6-8 


; 


? 


z 


4 
F 


3 


40 HFLOAT: SBASSMAT.iDN H 
42 END 


1 
1 


38c 70:35:18 FBASRTE. Sac TGASMATION. MAR: 1 


AX/VMS Macro v04-00 


3; expand to hfloat operations 
; end of BASSMAT_IDN 


Page 


2 
( 


0 
6 


) 


; 


M12 
-SEP- 43:4 AX/VMS Macro V04-00 Page 21 
Beet Elbe Beer 88e F8:55i7a FAXEHES Bacse VOR=OO anes <6) 
ym 
0000277 R 
DASESSCALE Rt - gaa ; 8 Looe p-i$t. set. 0090182 . 
BAEK AR AT eeeeeeee =X PT OND” UBB 000090 R 
BASEK_ARGDONN eeeseeee x L90P- ND “SUBD 0000471 
ree ita eerceeee 00 COOP"SND~SUBF 0000366 R 0 
aie 00000000 RG LOOP"5ND~SUBG 0000567 R 
pacecriat’s eeneeeee =X $6 LOOP= 2ND- SUBH a4 H R 0 
re th secceces of LOOP" END~SUBL 000e7AR 2 
BASES TOCEATE ORB oossses oO COUER BNI” = 00000004 
BASeSiocEATenRe eeveeeee x 00 LOWER BND2 = 00000000 
BASSSTO-FA-G-R8 eteeeeee x 0 vER = $3ee 
BASSSTO"FATH-RS etaeeere x OO t = 90000004 
BASSSTOTEATUTRE eecneeee X00 TER = 00000010 
Bees nF AWW ARE 00000064 R02 SFSL_SAVE_FP = 0000000¢ 
UNS = 00000008 UPPER BNDT = 00000008 
ShTAS 00000014 VALUE "DESC = 0000000¢ 
DOUB * 90000438 Rs 02 WORD 00000159 R02 
A AO = 00000010 
SCSA_A OO00A 
DSCSB_AFLAGS = 444 
DSCSB-CLASS = 00000005 
DSCSB-DINCT = 00900008 
DSCSB-DTYP = 90000002 
DSCSK-CLASS_BFA = 9000008 
DSCSK-DTYPE~ = 9000000 
DSCSK-DTYPE~ = 90900008 
DSC$K-DTYPE~DSC = 90000018 
DSCSK~DTYPE~ = 0000018 
DSCSK-DTYPE-H = 090001¢ 
pecgt-t)- = 00000024 
pee st-e- = 00000014 
a: a 
ite tee yo = 00000028 
DSCSV~FL BOUNDS = 90000007 
Dive — me itt 
ERR_ARGDONMAT 0000044 R 92 
ERR “DATTYPERR 44 ts 4 05 
ERR MATDIMERR 90000057 R 
oa BoopossA RC 
GFLOAT 0000554 R 
a ant 
INIT. TwO_SUBSB O7¢R 0 
INIT~TWO7SUBSD 0000437 R 9 
INI T~TWO7SUBSF 0000355 
INIT~TWO"SUBSG 9000540 R 9 
INIT~TWO"SUBSH 000647 R 0 
INIT~TWO7SUBSL 9000260 R 
INIT~TWO"SUBSW 0000168 R 
LOOP BO08bBp 
LOOP. 1ST_SUBB 08D 
LOOP" 1§T~SUBD O00046E R 
pane ee 
LOOP" 181~SUBH 000065E R 
| 
| 
| 


— 


N 12 
_BASSMAT_IDN 15-SEP-1984 23:43:41 VAX/VMS Macro V04-00 Page 22 
Psect synopsis g-SeP=1 984 10:38:18 EBASRTL. SRCIBASMATIDN.MAR; 1 Na: (6) 
became ere sawn en > 
: Psect synopsis ! 
Fone nw nese amen asa + 
PSECT name Allocation PSECT No. Attributes 
00000000 ( 0.) 00 ¢ 0.) NOPIC USR CON ABS LCL NOSHR NOEXE NORD NOWRT NOVEC BYTE 
00000000 3-3 01 ¢ 1.) NOPIC USR CON ABS LCL NOSHR EXE RD WRT NOVEC BYTE 
Q000072F ( 1839.) 02 ¢ 2.) PIC USR CON REL LCL SH EXE NOWRT NOVEC LONG 
eeeeee eee remem nan ean wanan = $+ 
: Performance indicators 3 
Elapsed Time 
Initialization 3 00:00:00.11 00:00:00.56 
Command processing 130 00:00:00.63 see ee 
Pass 224 Hs Be So 00:00:12.61 
Symbol table sort 0 00:00:00. ¢ 00:00:00.59 
Pass 2 112 00:00:01.9 00:00:04.24 
Symbol table output . 88:88 08 Be 00:00:00.09 
Psect synopsis output 3 00:00:00.0 00:00:00.03 
Cross-reference output 0 00:00:00.00 00:00:00.00 
Assembler run totals 514 00:00:09.75 00:00:20.84 
The working set Limit was 1350 pages. 7 
35843 bytes (71 pages) of virtual memory were used to buffer the intermediate code. 
There were 20 pages of symbol table space allocated to hold 220 non-local and 81 local symbols. 
542 source Lines were read in Pass 1, producing 17 object records in Pass 2. 


30 pages of virtual memory were used to define 10 macros. 


+ + 
! Macro Library statistics ! 
peewee owe ere eer enn e wee neem ens + 


Macros defined 


Macro Library name 


-$255$DUA28: CBASRTL.OBJ JBASRTL.MLB; 1 0 
$255$DUA28:CSYSLIBISTARLET.MLB;2 5 
TOTALS (all Libraries) 5 


223 GETS were required to define 5 macros. 
There were no errors, warnings or information messages. 


MACRO/ENABLE=SUPPRE SSION/DI SABLE=(GLOBAL , TRACEBACK) /LIS=L1S$:BASMATIDN/OBJ=OBJ$:BASMATIDN MSRC$:BASMAT IDN/UPDATE=(ENHS:BASMATIDN) +L 1 


vw _ @e ft 
zs 2s i 
~ oe Yr t 
vv “vw 7 
@ wr ' 
oO 
Oo 
i=] 
mm 
wv 
Qo 
[reo] 
@ 
~ 
isu 
Cc 
~ 
io 
tw 
o 
v 
Cc 
“~ 
= o 
3 
oO 
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